home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 21
/
Cream of the Crop 21 (Terry Blount) (October 1996).iso
/
os2
/
e33el2.zip
/
emacs
/
19.33
/
lisp
/
cal-hebrew.el
< prev
next >
Wrap
Lisp/Scheme
|
1996-01-20
|
57KB
|
1,181 lines
;;; cal-hebrew.el --- calendar functions for the Hebrew calendar.
;; Copyright (C) 1995 Free Software Foundation, Inc.
;; Author: Nachum Dershowitz <nachum@cs.uiuc.edu>
;; Edward M. Reingold <reingold@cs.uiuc.edu>
;; Keywords: calendar
;; Human-Keywords: Hebrew calendar, calendar, diary
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;; This collection of functions implements the features of calendar.el and
;; diary.el that deal with the Hebrew calendar.
;; Comments, corrections, and improvements should be sent to
;; Edward M. Reingold Department of Computer Science
;; (217) 333-6733 University of Illinois at Urbana-Champaign
;; reingold@cs.uiuc.edu 1304 West Springfield Avenue
;; Urbana, Illinois 61801
;;; Code:
(require 'calendar)
(defun calendar-hebrew-from-absolute (date)
"Compute the Hebrew date (month day year) corresponding to absolute DATE.
The absolute date is the number of days elapsed since the (imaginary)
Gregorian date Sunday, December 31, 1 BC."
(let* ((greg-date (calendar-gregorian-from-absolute date))
(month (aref [9 10 11 12 1 2 3 4 7 7 7 8]
(1- (extract-calendar-month greg-date))))
(day)
(year (+ 3760 (extract-calendar-year greg-date))))
(while (>= date (calendar-absolute-from-hebrew (list 7 1 (1+ year))))
(setq year (1+ year)))
(let ((length (hebrew-calendar-last-month-of-year year)))
(while (> date
(calendar-absolute-from-hebrew
(list month
(hebrew-calendar-last-day-of-month month year)
year)))
(setq month (1+ (% month length)))))
(setq day (1+
(- date (calendar-absolute-from-hebrew (list month 1 year)))))
(list month day year)))
(defun hebrew-calendar-leap-year-p (year)
"t if YEAR is a Hebrew calendar leap year."
(< (% (1+ (* 7 year)) 19) 7))
(defun hebrew-calendar-last-month-of-year (year)
"The last month of the Hebrew calendar YEAR."
(if (hebrew-calendar-leap-year-p year)
13
12))
(defun hebrew-calendar-last-day-of-month (month year)
"The last day of MONTH in YEAR."
(if (or (memq month (list 2 4 6 10 13))
(and (= month 12) (not (hebrew-calendar-leap-year-p year)))
(and (= month 8) (not (hebrew-calendar-long-heshvan-p year)))
(and (= month 9) (hebrew-calendar-short-kislev-p year)))
29
30))
(defun hebrew-calendar-elapsed-days (year)
"Days from Sun. prior to start of Hebrew calendar to mean conjunction of Tishri of Hebrew YEAR."
(let* ((months-elapsed
(+ (* 235 (/ (1- year) 19));; Months in complete cycles so far.
(* 12 (% (1- year) 19)) ;; Regular months in this cycle
(/ (1+ (* 7 (% (1- year) 19))) 19)));; Leap months this cycle
(parts-elapsed (+ 204 (* 793 (% months-elapsed 1080))))
(hours-elapsed (+ 5
(* 12 months-elapsed)
(* 793 (/ months-elapsed 1080))
(/ parts-elapsed 1080)))
(parts ;; Conjunction parts
(+ (* 1080 (% hours-elapsed 24)) (% parts-elapsed 1080)))
(day ;; Conjunction day
(+ 1 (* 29 months-elapsed) (/ hours-elapsed 24)))
(alternative-day
(if (or (>= parts 19440) ;; If the new moon is at or after midday,
(and (= (% day 7) 2);; ...or is on a Tuesday...
(>= parts 9924) ;; at 9 hours, 204 parts or later...
(not (hebrew-calendar-leap-year-p year)));; of a
;; common year,
(and (= (% day 7) 1);; ...or is on a Monday...
(>= parts 16789) ;; at 15 hours, 589 parts or later...
(hebrew-calendar-leap-year-p (1- year))));; at the end
;; of a leap year
;; Then postpone Rosh HaShanah one day
(1+ day)
;; Else
day)))
(if ;; If Rosh HaShanah would occur on Sunday, Wednesday, or Friday
(memq (% alternative-day 7) (list 0 3 5))
;; Then postpone it one (more) day and return
(1+ alternative-day)
;; Else return
alternative-day)))
(defun hebrew-calendar-days-in-year (year)
"Number of days in Hebrew YEAR."
(- (hebrew-calendar-elapsed-days (1+ year))
(hebrew-calendar-elapsed-days year)))
(defun hebrew-calendar-long-heshvan-p (year)
"t if Heshvan is long in Hebrew YEAR."
(= (% (hebrew-calendar-days-in-year year) 10) 5))
(defun hebrew-calendar-short-kislev-p (year)
"t if Kislev is short in Hebrew YEAR."
(= (% (hebrew-calendar-days-in-year year) 10) 3))
(defun calendar-absolute-from-hebrew (date)
"Absolute date of Hebrew DATE.
The absolute date is the number of days elapsed since the (imaginary)
Gregorian date Sunday, December 31, 1 BC."
(let* ((month (extract-calendar-month date))
(day (extract-calendar-day date))
(year (extract-calendar-year date)))
(+ day ;; Days so far this month.
(if (< month 7);; before Tishri
;; Then add days in prior months this year before and after Nisan
(+ (calendar-sum
m 7 (<= m (hebrew-calendar-last-month-of-year year))
(hebrew-calendar-last-day-of-month m year))
(calendar-sum
m 1 (< m month)
(hebrew-calendar-last-day-of-month m year)))
;; Else add days in prior months this year
(calendar-sum
m 7 (< m month)
(hebrew-calendar-last-day-of-month m year)))
(hebrew-calendar-elapsed-days year);; Days in prior years.
-1373429))) ;; Days elapsed before absolute date 1.
(defvar calendar-hebrew-month-name-array-common-year
["Nisan" "Iyar" "Sivan" "Tammuz" "Av" "Elul" "Tishri"
"Heshvan" "Kislev" "Teveth" "Shevat" "Adar"])
(defvar calendar-hebrew-month-name-array-leap-year
["Nisan" "Iyar" "Sivan" "Tammuz" "Av" "Elul" "Tishri"
"Heshvan" "Kislev" "Teveth" "Shevat" "Adar I" "Adar II"])
(defun calendar-hebrew-date-string (&optional date)
"String of Hebrew date before sunset of Gregorian DATE.
Defaults to today's date if DATE is not given.
Driven by the variable `calendar-date-display-form'."
(let* ((hebrew-date (calendar-hebrew-from-absolute
(calendar-absolute-from-gregorian
(or date (calendar-current-date)))))
(calendar-month-name-array
(if (hebrew-calendar-leap-year-p (extract-calendar-year hebrew-date))
calendar-hebrew-month-name-array-leap-year
calendar-hebrew-month-name-array-common-year)))
(calendar-date-string hebrew-date nil t)))
(defun calendar-print-hebrew-date ()
"Show the Hebrew calendar equivalent of the date under the cursor."
(interactive)
(message "Hebrew date (until sunset): %s"
(calendar-hebrew-date-string (calendar-cursor-to-date t))))
(defun hebrew-calendar-yahrzeit (death-date year)
"Absolute date of the anniversary of H